unit uHash;

interface

uses
  {$IFDEF MSWINDOWS}
  Windows,
  {$ENDIF}
  SysUtils, Classes, Types, SyncObjs;

type
  {$if CompilerVersion < 23}
  NativeUInt = Cardinal;
  NativeInt = Integer;
  {$ifend}
  Number = NativeInt;
  NumberU = NativeUInt;
  PNumber = ^Number;
  PNumberU = ^NumberU;
  PDWORD = ^DWORD;

  THashType = NumberU;

  PPIntHashItem = ^PIntHashItem;
  PIntHashItem = ^TIntHashItem;
  TIntHashItem = record
    Next: PIntHashItem;
    Key: THashType;
    Value: Number;
  end;

  TYXDIntHashItemFreeNotify = procedure (Item: PIntHashItem) of object;

  TIntHash = class
  private
    FCount: Integer;
    FLocker: TCriticalSection;
    FOnFreeItem: TYXDIntHashItemFreeNotify;
    function GetBucketsCount: Integer;
    function GetValueItem(const Key: THashType): Number;
    procedure SetValueItem(const Key: THashType; const Value: Number);
  public
    Buckets: array of PIntHashItem;
    constructor Create(Size: Cardinal = 331);
    destructor Destroy; override;
    function Find(const Key: THashType): PPIntHashItem;
    procedure Add(const Key: THashType; Value: Number);
    procedure AddOrUpdate(const Key: THashType; Value: Number);
    procedure Clear;
    procedure Lock;
    procedure UnLock;
    function Remove(const Key: THashType): Boolean;
    function Modify(const Key: THashType; Value: Number): Boolean;
    function ValueOf(const Key: THashType; const DefaultValue: Number = -1): Number;
    function Exists(const Key: THashType): Boolean;
    property Values[const Key: THashType]: Number read GetValueItem write SetValueItem;
    property Count: Integer read FCount;
    property BucketsCount: Integer read GetBucketsCount;
    property OnFreeItem: TYXDIntHashItemFreeNotify read FOnFreeItem write FOnFreeItem;
  end;

implementation

{ TIntHash }

procedure TIntHash.Add(const Key: THashType; Value: Number);
var
  Hash: Integer;
  Bucket: PIntHashItem;
begin
  Hash := Key mod Cardinal(Length(Buckets));
  New(Bucket);
  Bucket^.Key := Key;
  Bucket^.Value := Value;
  FLocker.Enter;
  Bucket^.Next := Buckets[Hash];
  Buckets[Hash] := Bucket;
  Inc(FCount);
  FLocker.Leave;
end;

procedure TIntHash.AddOrUpdate(const Key: THashType; Value: Number);
begin
  if not Modify(Key, Value) then
    Add(Key, Value);
end;

procedure TIntHash.Clear;
var
  I: Integer;
  P, N: PIntHashItem;
begin
  FLocker.Enter;
  for I := 0 to Length(Buckets) - 1 do begin
    P := Buckets[I];
    while P <> nil do begin
      N := P^.Next;
      if Assigned(FOnFreeItem) then
        FOnFreeItem(P);
      Dispose(P);
      P := N;
    end;
    Buckets[I] := nil;
  end;
  FLocker.Leave;
end;

constructor TIntHash.Create(Size: Cardinal);
begin
  inherited Create;
  FLocker := TCriticalSection.Create;
  SetLength(Buckets, Size);
  FCount := 0;
end;

destructor TIntHash.Destroy;
begin
  FLocker.Enter;
  try
    Clear;
    inherited Destroy;
  finally
    FLocker.Free;
  end;
end;

function TIntHash.Exists(const Key: THashType): Boolean;
begin
  FLocker.Enter;
  Result := Find(Key)^ <> nil;
  FLocker.Leave;
end;

function TIntHash.Find(const Key: THashType): PPIntHashItem;
begin
  Result := @Buckets[Key mod Cardinal(Length(Buckets))];
  while Result^ <> nil do begin
    if Result^.Key = Key then
      Exit
    else
      Result := @Result^.Next;
  end;
end;

function TIntHash.GetBucketsCount: Integer;
begin
  Result := Length(Buckets);
end;

function TIntHash.GetValueItem(const Key: THashType): Number;
begin
  Result := ValueOf(Key);
end;

procedure TIntHash.Lock;
begin
  FLocker.Enter;
end;

function TIntHash.Modify(const Key: THashType; Value: Number): Boolean;
var
  P: PIntHashItem;
begin
  FLocker.Enter;
  P := Find(Key)^;
  if P <> nil then
  begin
    Result := True;
    if Assigned(FOnFreeItem) then
      FOnFreeItem(P);
    P^.Value := Value;
  end
  else
    Result := False;
  FLocker.Leave;
end;

function TIntHash.Remove(const Key: THashType): Boolean;
var
  P: PIntHashItem;
  Prev: PPIntHashItem;
begin
  Result := False;
  FLocker.Enter;
  Prev := Find(Key);
  P := Prev^;
  if P <> nil then begin
    Result := True;
    Prev^ := P^.Next;
    if Assigned(FOnFreeItem) then
      FOnFreeItem(P);
    Dispose(P);
  end;
  FLocker.Leave;
end;

procedure TIntHash.SetValueItem(const Key: THashType; const Value: Number);
begin
  AddOrUpdate(Key, Value);
end;

procedure TIntHash.UnLock;
begin
  FLocker.Leave;
end;

function TIntHash.ValueOf(const Key: THashType; const DefaultValue: Number): Number;
var
  P: PIntHashItem;
begin
  FLocker.Enter;
  P := Find(Key)^;
  if P <> nil then
    Result := P^.Value
  else
    Result := DefaultValue;
  FLocker.Leave;
end;

end.
